home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / PAINT.PAK / PAINT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  12KB  |  454 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows: Paint Demo         }
  4. {   Paint Program                                }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program Paint;
  10.  
  11. { The main program file for the paint program.
  12.  
  13.   The paint program is a simple drawing program that demonstrates the
  14.   use of the Object Windows Library (OWL) and of programming with the Windows
  15.   Graphics Device Interface (GDI).
  16. }
  17.  
  18. uses PaintDef, ResDef, PaintDlg, ToolBar, LineBar, Palette, Canvas,
  19.   WinTypes, WinProcs, WObjects, Strings;
  20.  
  21. {$R PAINT}
  22.  
  23. { Global declarations }
  24. const
  25.  
  26.   FileNameMax = 80;        { Max length of file names }
  27.  
  28. type
  29.  
  30.   {
  31.     The main drawing window. Responsible for creating and maintaining
  32.     subwindows for tool, color and line selection, and for menu management.
  33.   }
  34.   PPaintWin = ^TPaintWin;
  35.   TPaintWin = object(TWindow)
  36.     State: TState;        { Drawing state of the program }
  37.     Palette: PPalette;        { Color palette }
  38.     ToolBar: PToolBar;        { Palette of available tools }
  39.     LineBar: PLineBar;        { Palette of available line widths }
  40.     Canvas: PCanvas;        { Window to actually draw on }
  41.     FileName: array [0..FileNameMax] of Char;
  42.                                 { File name associated with current window }
  43.     CBChainNext: HWnd;        { Next window in the clipboard chain }
  44.  
  45.     { Creation }
  46.     constructor Init;
  47.     function GetClassName: PChar; virtual;
  48.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  49.     procedure SetUpWindow; virtual;
  50.     function CanClose: Boolean; virtual;
  51.  
  52.     { Utility }
  53.     procedure SetNames(NewName: PChar);
  54.     procedure UpdateChildren;
  55.  
  56.     { Window manager interface routines }
  57.     procedure WMSize(var Msg: TMessage);
  58.       virtual wm_First + wm_Size;
  59.     procedure WMChangeCBChain(var Msg: TMessage);
  60.       virtual wm_First + wm_ChangeCBChain;
  61.     procedure WMDrawClipBoard(var Msg: TMessage);
  62.       virtual wm_First + wm_DrawClipBoard;
  63.     procedure WMDestroy(var Msg: TMessage);
  64.       virtual wm_First + wm_Destroy;
  65.  
  66.     { Menu routines }
  67.     procedure CMFileNew(var Msg: TMessage);
  68.       virtual cm_First + cm_FileNew;
  69.     procedure CMFileOpen(var Msg: TMessage);
  70.       virtual cm_First + cm_FileOpen;
  71.     procedure CMFileSave(var Msg: TMessage);
  72.       virtual cm_First + cm_FileSave;
  73.     procedure CMFileSaveAs(var Msg: TMessage);
  74.       virtual cm_First + cm_FileSaveAs;
  75.  
  76.     procedure CMEditUndo(var Msg: TMessage);
  77.       virtual cm_First + cm_EditUndo;
  78.     procedure CMEditCut(var Msg: TMessage);
  79.       virtual cm_First + cm_EditCut;
  80.     procedure CMEditCopy(var Msg: TMessage);
  81.       virtual cm_First + cm_EditCopy;
  82.     procedure CMEditPaste(var Msg: TMessage);
  83.       virtual cm_First + cm_EditPaste;
  84.     procedure CMEditDelete(var Msg: TMessage);
  85.       virtual cm_First + cm_EditDelete;
  86.     procedure CMEditClear(var Msg: TMessage);
  87.       virtual cm_First + cm_EditClear;
  88.  
  89.     procedure CMOptionsSize(var Msg: TMessage);
  90.       virtual cm_First + cm_OptionsSize;
  91.  
  92.     procedure CMHelpAbout(var Msg: TMessage);
  93.       virtual cm_First + cm_HelpAbout;
  94.   end;
  95.  
  96.   {
  97.     A paint application.
  98.   }
  99.   TPaintApp = object(TApplication)
  100.     procedure InitMainWindow; virtual;
  101.   end;
  102.  
  103. { TPaintWin }
  104.  
  105. { Create a drawing window, initializing its drawing state and associated
  106.   windows.
  107. }
  108. constructor TPaintWin.Init;
  109. begin
  110.   TWindow.Init(nil, 'Paint');
  111.  
  112.   { Set up the menu bar }
  113.   Attr.Menu := LoadMenu(HInstance, 'PaintMenu');
  114.  
  115.   { Initialize the drawing state }
  116.   with State do
  117.   begin
  118.     PaintTool := nil;
  119.     MemDC := 0;
  120.     IsDirtyBitmap := False;
  121.     SetRectEmpty(Selection);
  122.     SelectionBM := 0;
  123.     PenSize := 3;
  124.     PenColor := $000000;
  125.     BrushColor := $FFFFFF;
  126.     BitmapSize.X := 640;
  127.     BitmapSize.Y := 480;
  128.   end;
  129.  
  130.   { Create the associated windows }
  131.   Palette := New(PPalette, Init(@Self, @State));
  132.   ToolBar := New(PToolBar, Init(@Self, @State));
  133.   LineBar := New(PLineBar, Init(@Self, @State));
  134.   Canvas := New(PCanvas, Init(@Self, @State));
  135.  
  136.   { Set up the file name }
  137.   FileName[0] := #0;
  138.  
  139.   CBChainNext := 0;
  140. end;
  141.  
  142. function TPaintWin.GetClassName: PChar;
  143. begin
  144.   GetClassName := 'TPaintWin';
  145. end;
  146.  
  147. procedure TPaintWin.GetWindowClass(var WndClass: TWndClass);
  148. begin
  149.   TWindow.GetWindowClass(WndClass);
  150.   WndClass.hbrBackground := color_AppWorkspace + 1;
  151.   WndClass.hIcon := LoadIcon(HInstance, 'PaintIcon');
  152. end;
  153.  
  154. procedure TPaintWin.SetupWindow;
  155. begin
  156.   TWindow.SetupWindow;
  157.   if IsClipboardFormatAvailable(cf_Bitmap) then
  158.     EnableMenuItem(Attr.Menu, cm_EditPaste, mf_enabled);
  159.   CBChainNext := SetClipBoardViewer(HWindow);
  160. end;
  161.  
  162. { Set the name of the file associated with the window and display it in the
  163.   title bar.
  164. }
  165. procedure TPaintWin.SetNames(NewName: PChar);
  166. var
  167.   Name: array[0..FileNameMax + 10] of Char;     { Title bar has 'Paint -'
  168.                                                   prepended }
  169. begin
  170.  
  171.   { Create name for title bar }
  172.   StrCopy(Name, 'Paint');
  173.   if StrComp(NewName, '') <> 0 then
  174.   begin
  175.     StrCat(Name, ' - ');
  176.     StrCat(Name, NewName);
  177.   end;
  178.  
  179.   { Set title bar }
  180.   SetCaption(Name);
  181.  
  182.   { Set file name }
  183.   StrCopy(FileName, NewName);
  184. end;
  185.  
  186. procedure TPaintWin.UpdateChildren;
  187. var
  188.   S: Integer;            { Lower coordinates of Palette }
  189.   R: TRect;            { Window client area }
  190.   CX, CY: Integer;
  191. begin
  192.   GetClientRect(HWindow, R);
  193.   S := ((R.bottom - 8) div 17) * 3 + 1;
  194.   MoveWindow(Palette^.HWindow, 4, 4, S, R.bottom - 8, True);
  195.   MoveWindow(ToolBar^.HWindow, S + 8, 4, (Ord(MaxTool) + 1) * 31 + 1,
  196.     32, True);
  197.   MoveWindow(LineBar^.HWindow, S + (Ord(MaxTool) + 1) * 31 + 13, 4,
  198.     LineBarWidth, 32, True);
  199.   Canvas^.MoveSelf(S + 8, 40, R.Right - S - 12, R.Bottom - 44, True);
  200. end;
  201.  
  202. { Window manager interface routines }
  203.  
  204. { Resize the window and resize associated windows proportionately.
  205. }
  206. procedure TPaintWin.WMSize(var Msg: TMessage);
  207. begin
  208.   TWindow.WMSize(Msg);
  209.   UpdateChildren;
  210. end;
  211.  
  212. { Update the clipboard chain link, or pass down the message.
  213. }
  214. procedure TPaintWin.WMChangeCBChain(var Msg: TMessage);
  215. begin
  216.   if Msg.WParam = CBChainNext then
  217.     CBChainNext := Msg.lParamLo
  218.   else
  219.     if CBChainNext <> 0 then
  220.       SendMessage(CBChainNext, Msg.Message, Msg.WParam, Msg.lParam);
  221. end;
  222.  
  223. { Enable/disable menus to reflect a change in the state of the clipboard.
  224. }
  225. procedure TPaintWin.WMDrawClipBoard(var Msg: TMessage);
  226. begin
  227.   if IsClipboardFormatAvailable(cf_Bitmap) then
  228.     EnableMenuItem(Attr.Menu, cm_EditPaste, mf_enabled)
  229.   else
  230.     EnableMenuItem(Attr.Menu, cm_EditPaste, mf_grayed);
  231.   if CBChainNext <> 0 then
  232.     SendMessage(CBChainNext, Msg.Message, 0, 0);
  233. end;
  234.  
  235. { Notify the clipboard chain before dying.
  236. }
  237. procedure TPaintWin.WMDestroy(var Msg: TMessage);
  238. begin
  239.   ChangeClipboardChain(HWindow, CBChainNext);
  240.   TWindow.WMDestroy(Msg);
  241. end;
  242.  
  243.  
  244. { File menu functions }
  245. { Create a new canvas and destroy the old one.
  246. }
  247. procedure TPaintWin.CMFileNew(var Msg: TMessage);
  248. var
  249.   CurA: TWindowAttr;        { Save the current window attributes }
  250.   aMsg: TMessage;
  251. begin
  252.  
  253.   { Make sure the current image is saved if desired. }
  254.   if State.IsDirtyBitmap then
  255.     case AskCancel('Save current image?') of
  256.       id_Yes: CMFileSave(msg);
  257.       id_Cancel: exit;
  258.     end;
  259.  
  260.   { Mark the bitmap as unmodified }
  261.   State.IsDirtyBitmap := False;
  262.   CurA := Canvas^.Attr;
  263.  
  264.   { Destroy the old canvas }
  265.   Canvas^.Done;
  266.  
  267.   { Create a new one }
  268.   SetNames('');
  269.   Canvas := PCanvas(Application^.MakeWindow(New(PCanvas, Init(@Self,
  270.     @State))));
  271.  
  272.   { Size the window appropriately }
  273.   UpdateChildren;
  274. end;
  275.  
  276. { Read a bitmap from file into the canvas.
  277. }
  278. procedure TPaintWin.CMFileOpen(var msg: TMessage);
  279. var
  280.   FN: array [0..FileNameMax] of Char;        { The file name }
  281.   Curs: HCursor;
  282. begin
  283.  
  284.   { Make sure the current image is saved if desired }
  285.   if State.IsDirtyBitmap then
  286.     case AskCancel('Save current image?') of
  287.       id_Yes: CMFileSave(msg);
  288.       id_Cancel: exit;
  289.     end;
  290.  
  291.   { Create a mask for the file dialog }
  292.   StrCopy(FN, '*.bmp');
  293.  
  294.   { Prompt for the file and load the bitmap }
  295.   if FileOpenDialog(FN) then
  296.   begin
  297.     Curs := SetCursor(LoadCursor(0, idc_Wait));
  298.     if (Canvas^.Load(FN) <> 0) then
  299.     begin
  300.       SetNames(FN);
  301.       UpdateChildren;
  302.     end;
  303.     SetCursor(Curs);
  304.   end;
  305. end;
  306.  
  307. { Save the current bitmap to file.
  308. }
  309. procedure TPaintWin.CMFileSave(var msg: TMessage);
  310. var Curs: HCursor;        { The current cursor }
  311. begin
  312.   
  313.   { Make sure there is a file name to be saved to }
  314.   if StrComp(FileName, '') = 0 then
  315.     CMFileSaveAs(msg)
  316.   else
  317.   begin
  318.     { Set the cursor while the file is being written }
  319.     Curs := SetCursor(LoadCursor(0, idc_Wait));
  320.     Canvas^.Store(FileName);
  321.     SetCursor(Curs);
  322.   end;
  323. end;
  324.  
  325. { Prompt for a file name then save the current bitmap to that file.
  326. }
  327. procedure TPaintWin.CMFileSaveAs(var msg: TMessage);
  328. var
  329.   FN: array[0..FileNameMax] of Char;    { The file name }
  330.   Curs: HCursor;                           { The current cursor }
  331. begin
  332.   { Create a mask for the file dialog }
  333.   StrCopy(FN, '*.bmp');
  334.  
  335.   { Prompt for the file name }
  336.   if FileSaveDialog(FN) then
  337.   begin
  338.     { Set the cursor while the file is being written }
  339.     Curs := SetCursor(LoadCursor(0, idc_Wait));
  340.     if Canvas^.Store(FN) <> 0 then SetNames(FN);
  341.     SetCursor(Curs);
  342.   end;
  343. end;
  344.  
  345. { Make sure the bitmap is saved if desired before dying or cancel if desired.
  346. }
  347. function TPaintWin.CanClose: Boolean;
  348. var Msg: TMessage;            { Bogus to pass on }
  349. begin
  350.   CanClose := True;
  351.   if State.IsDirtyBitmap then
  352.     case AskCancel('Save current image?') of
  353.       id_Yes: CMFileSave(Msg);
  354.       id_Cancel: CanClose := False;
  355.     end;
  356. end;
  357.  
  358.  
  359. { Edit menu functions }
  360.  
  361. { Undo the last change to the bitmap.
  362. }
  363. procedure TPaintWin.CMEditUndo(var Msg: TMessage);
  364. begin
  365.   Canvas^.Undo;
  366. end;
  367.  
  368. { Copy the current selection to the clipboard and clear it from the screen.
  369. }
  370. procedure TPaintWin.CMEditCut(var Msg: TMessage);
  371. begin
  372.   Canvas^.Cut;
  373. end;
  374.  
  375. { Copy the current selection to the clipboard.
  376. }
  377. procedure TPaintWin.CMEditCopy(var Msg: TMessage);
  378. begin
  379.   Canvas^.Copy;
  380. end;
  381.  
  382. { Retrieve the contents of the clipboard and make it the current selection.
  383. }
  384. procedure TPaintWin.CMEditPaste(var Msg: TMessage);
  385. begin
  386.   ToolBar^.ToolSelect(SelectTool);
  387.   Canvas^.Paste;
  388. end;
  389.  
  390. { Clear the current selection from the screen.
  391. }
  392. procedure TPaintWin.CMEditDelete(var Msg: TMessage);
  393. begin
  394.   Canvas^.Delete;
  395. end;
  396.  
  397. { Clear the entire drawing area.
  398. }
  399. procedure TPaintWin.CMEditClear(var Msg: TMessage);
  400. begin
  401.   Canvas^.ClearAll;
  402. end;
  403.  
  404. { Options }
  405. procedure TPaintWin.CMOptionsSize(var Msg: TMessage);
  406. var
  407.   SizeBMInfo: TSizeBMInfo;
  408. begin
  409.   with SizeBMInfo, State do
  410.     begin
  411.       Width := BitmapSize.X;
  412.       Height := BitmapSize.Y;
  413.       CurrentBMFlag := id_PadBM;
  414.     end;
  415.   if Application^.ExecDialog(New(PSizeBMDialog, Init(@Self, 'SizeBMDialog',
  416.     @SizeBMInfo))) = id_OK then
  417.   begin
  418.     with State, SizeBMInfo do
  419.     begin
  420.       BitmapSize.X := Width;
  421.       BitmapSize.Y := Height;
  422.     end;
  423.     Canvas^.Resize(SizeBMInfo.CurrentBMFlag);
  424.     WMSize(Msg);
  425.   end;
  426. end;
  427.   
  428.  
  429. { Help }
  430. { Display the 'About Box'.
  431. }
  432. procedure TPaintWin.CMHelpAbout(var Msg: TMessage);
  433. begin
  434.   Application^.ExecDialog(New(PDialog, Init(@Self, 'AboutDialog')));
  435. end;
  436.  
  437. { TPaintApp }
  438.  
  439. { Create the main window for the paint application.
  440. }
  441. procedure TPaintApp.InitMainWindow;
  442. begin
  443.   MainWindow := New(PPaintWin, Init);
  444. end;
  445.  
  446. var
  447.   PaintApp: TPaintApp;
  448.  
  449. begin
  450.   PaintApp.Init('Paint');
  451.   PaintApp.Run;
  452.   PaintApp.Done;
  453. end.
  454.